Option Explicit

Public objCon     As New ADODB.Connection    'Microsoft ActiveX Data Objects 2.7 Library
Public objRs      As New ADODB.Recordset     'Microsoft ActiveX Data Objects 2.7 Library

Dim pCache      As PivotCache
Dim pPt         As PivotTable
Dim pPf         As PivotField
Dim pPi         As PivotItem

Const DB_PASS As String = "sa"
Const DB_ID As String = "sa"
Const DB_CATALOG As String = "JUNDW"
Const DB_SOURCE As String = "(local)"


Const AlertTitle As String = "Notice"


'Param변수
'V_FROM_MONTH 201105
'V_TO_MONTH 201112
'V_BASE_CELL B10
'V_PIVOT_NAME myPivot
'V_HEADER_DISPLAY True
'V_AUTOFILTER True



'======================================================================================================================

Sub proc_ADO_Connect()
    Dim strCon As String

    'http://fivewind.tistory.com/39 Connection 스트링 쉽게 만들기 참조
    strCon = ""
    strCon = strCon & "Provider=SQLOLEDB.1;Password=" & DB_PASS & ";Persist Security Info=True;"
    strCon = strCon & "User ID=" & DB_ID & ";Initial Catalog=" & DB_CATALOG & ";Data Source=" & DB_SOURCE
    
    On Error GoTo ErrHandle
    objCon.Open strCon
    
    GoTo CommHandle
    
ErrHandle:
    MsgBox Err.Number & " : " & Err.Description, vbCritical, AlertTitle
    
CommHandle:
End Sub


Sub proc_RS_Open(strQry As String)
    objRs.CursorLocation = adUseClient
    objRs.Open strQry, objCon, adOpenStatic, adLockOptimistic
End Sub



Sub proc_ADO_Close()
    On Error Resume Next
    objRs.Close: Set objRs = Nothing
    objCon.Close: Set objCon = Nothing
    On Error GoTo 0
End Sub


Function func_IsPivotExist() As Boolean
    If ActiveSheet.PivotTables.Count > 0 Then
        func_IsPivotExist = True
    Else
        func_IsPivotExist = False
    End If
End Function

'======================================================================================================================


Sub proc_OLAP()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    On Error GoTo ErrHandle

    Dim sht As Worksheet
    Dim V_FROM_MONTH As String
    Dim V_TO_MONTH As String
    Dim V_PIVOT_NAME As String
    Dim rngBase As Range
    Dim strQuery As String
    
    'Set sht = ActiveSheet
    Set sht = Worksheets("Sheet1")
    
    With Worksheets("Param")
        V_FROM_MONTH = .Range("V_FROM_MONTH")
        V_TO_MONTH = .Range("V_TO_MONTH")
        V_PIVOT_NAME = .Range("V_PIVOT_NAME")
        Set rngBase = Range(.Range("V_BASE_CELL"))
    End With

    strQuery = "SELECT * FROM MST_WEEKLY_BUCKET_INFO "  '실행할 쿼리문
    strQuery = strQuery & vbCrLf & "WHERE BUCKET_MONTH>=" & V_FROM_MONTH & " AND BUCKET_MONTH<=" & V_TO_MONTH
    
    Call proc_ADO_Connect    'ADO 연결
    Call proc_RS_Open(strQuery)  'RecordSet 연결
    
    
'**********************************************************************************************
    If func_IsPivotExist = True Then    '조회결과를 기존 피벗 캐시로 연결해서 가져오기
        Set pCache = ActiveSheet.PivotTables(1).PivotCache
        Set pCache.Recordset = objRs
        pCache.Refresh
    Else                                '피벗 캐시 생성 후 조회결과 가져오기
        Set pCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
        Set pCache.Recordset = objRs
        pCache.CreatePivotTable tabledestination:=rngBase, Tablename:=V_PIVOT_NAME
        
        '피벗 필드 배치시키기
        Set pPt = ActiveSheet.PivotTables(1)
        Set pPf = pPt.PivotFields("BUCKET_MONTH")
        pPf.Orientation = xlRowField
        pPf.Orientation = xlDataField
    End If
'**********************************************************************************************


    Call proc_ADO_Close
    GoTo CommHandle
    
    
ErrHandle:
    MsgBox Err.Number & " : " & Err.Description, vbCritical, AlertTitle
    
CommHandle:
    Range("A1").Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub




Sub proc_TABLE()
    'http://support.microsoft.com/kb/246335

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    On Error GoTo ErrHandle

    Dim sht As Worksheet
    Dim V_FROM_MONTH As String
    Dim V_TO_MONTH As String
    Dim V_PIVOT_NAME As String
    Dim V_HEADER_DISPLAY As Boolean
    Dim V_AUTOFILTER As Boolean
    Dim rngBase As Range
    Dim strQuery As String
    
    'Set sht = ActiveSheet
    Set sht = Worksheets("Sheet2")
    sht.Cells.Clear

    With Worksheets("Param")
        V_FROM_MONTH = .Range("V_FROM_MONTH")
        V_TO_MONTH = .Range("V_TO_MONTH")
        V_PIVOT_NAME = .Range("V_PIVOT_NAME")
        V_HEADER_DISPLAY = .Range("V_HEADER_DISPLAY")
        V_AUTOFILTER = .Range("V_AUTOFILTER")
        Set rngBase = Range(.Range("V_BASE_CELL"))
    End With

    strQuery = "SELECT * FROM MST_WEEKLY_BUCKET_INFO "  '실행할 쿼리문
    strQuery = strQuery & vbCrLf & "WHERE BUCKET_MONTH>=" & V_FROM_MONTH & " AND BUCKET_MONTH<=" & V_TO_MONTH

    Call proc_ADO_Connect    'ADO 연결
    Call proc_RS_Open(strQuery)  'RecordSet 연결
    
'**********************************************************************************************
    If V_HEADER_DISPLAY = True Then Call proc_TABLE_FieldName_Display(objRs, rngBase)
    If V_AUTOFILTER = True Then Call proc_TABLE_Autofilter(rngBase)
    rngBase.CopyFromRecordset objRs
'**********************************************************************************************

    Call proc_ADO_Close
    GoTo CommHandle
    
    
ErrHandle:
    MsgBox Err.Number & " : " & Err.Description, vbCritical, AlertTitle
    
CommHandle:
    Range("A1").Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Sub proc_TABLE_FieldName_Display(rs As Recordset, rngBase As Range)
    '헤더출력
    'http://stackoverflow.com/questions/3494887/how-to-connect-excel-to-ms-sql-and-get-data-with-column-names
    Dim i
    Dim objField
    
    i = 0
    For Each objField In rs.Fields
        rngBase.Offset(-1, i) = objField.Name
        i = i + 1
    Next objField
End Sub

Sub proc_TABLE_Autofilter(rngBase As Range)
    rngBase.AutoFilter Field:=1, visibledropdown:=True
End Sub
